home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / regexp / scm2doc.scm < prev    next >
Encoding:
Text File  |  1991-04-02  |  7.0 KB  |  182 lines
  1. ;;;; -*- Scheme -*-
  2. ;;;; $Header: /home/panda/pg/bevan/progs/elk/scm/RCS/scm2doc.scm,v 1.2 91/04/02 19:52:10 bevan Exp $
  3. ;;;+c
  4. ;;; Generate a documentation file from Scheme source.
  5. ;;; Requires the Scheme file to be formatted in a particular way.
  6. ;;;
  7. ;;; All functions to be included in the documentation should have a comment
  8. ;;; preceeding them containing a +f/-f around the section to appear in
  9. ;;; the output.
  10. ;;;
  11. ;;; All misc. section to appear in the output should be contained within
  12. ;;; +c/-c pairs.
  13. ;;;
  14. ;;; System : ELK
  15. ;;; System Specific Features :-
  16. ;;;   (error name string args ...)  ;; report an error
  17. ;;;   (require name)                ;; as in CommonLisp
  18. ;;;   (read-string port)            ;; read a line from a given port
  19. ;;;                                 ;; and return it
  20. ;;;-c 
  21.  
  22. (require 'ieee)
  23. (require 'string-extensions)
  24.  
  25. ;;;+f
  26. ;;; Set this to a string containing the comment style you prefer.
  27. ;;;-f
  28. (define scm2doc:comment-prefix
  29.   ";;;")
  30.  
  31. ;;;+f
  32. ;;; Define this to be the width of the output text.
  33. ;;; Note currently that all this is used for is generating the title.
  34. ;;;-f
  35. (define scm2doc:format-width
  36.   79)
  37.  
  38. (define scm2doc:comment-prefix-len (string-length scm2doc:comment-prefix))
  39. (define scm2doc:generic-comment-end (string-append scm2doc:comment-prefix "-"))
  40. (define scm2doc:comment-start (string-append scm2doc:comment-prefix "+c"))
  41. (define scm2doc:comment-end (string-append scm2doc:comment-prefix "-c"))
  42. (define scm2doc:function-start (string-append scm2doc:comment-prefix "+f"))
  43. (define scm2doc:function-end (string-append scm2doc:comment-prefix "-f"))
  44.  
  45. ;;;+f
  46. ;;; Produce a documentation file `outfile' for the scheme file `infile'.
  47. ;;;-f
  48. (define (scm2doc:main infile outfile)
  49.   (let ((in-port (open-input-file infile))
  50.     (out-port (open-output-file outfile)))
  51.     (display (string-center infile scm2doc:format-width) out-port)
  52.     (newline out-port)
  53.     (scm2doc:extract-documentation in-port out-port)
  54.     (close-input-port in-port)
  55.     (close-output-port out-port)))
  56.  
  57. ;;; Extract the documentation for the Scheme program on the input port
  58. ;;; `in-port' and write it to the output port `out-port'
  59. ;;; Returns : unspecified
  60. ;;;
  61. (define (scm2doc:extract-documentation in-port out-port)
  62.   (let loop ((line (read-string in-port)))
  63.     (if (eof-object? line)
  64.     #t
  65.     (begin
  66.       (cond ((string-prefix? line scm2doc:comment-start)
  67.          (newline out-port)
  68.          (scm2doc:extract-commentary in-port out-port))
  69.         ((string-prefix? line scm2doc:function-start)
  70.          (newline out-port)
  71.          (scm2doc:extract-function in-port out-port)))
  72.       (loop (read-string in-port))))))
  73.  
  74. ;;; Extract a comment section from the input port `in-port' and write
  75. ;;; it out to the output port `out-port'.  Initially the input should be on the
  76. ;;; first line of the comment section start.  After the comment has been read,
  77. ;;; the input will be such that the next line to be read will be the next
  78. ;;; line after the end of the comment.
  79. ;;; Returns : unspecified
  80. ;;;
  81. (define (scm2doc:extract-commentary in-port out-port)
  82.   (let loop ((line (read-string in-port)))
  83.     (if (eof-object? line)
  84.     (error 'scm2doc:extract-commentary "unexpected end of file"))
  85.     (cond ((string-prefix? line scm2doc:comment-end) #t)
  86.       ((string-prefix? line scm2doc:comment-prefix)
  87.        (display (substring line scm2doc:comment-prefix-len (string-length line)) out-port)
  88.        (newline out-port)
  89.        (loop (read-string in-port)))
  90.       (else (error 'scm2doc:extract-commentary "invalid chars in commentary")))))
  91.  
  92. ;;; Extract a function + comment from the input port `in-port' and output
  93. ;;; it on the output port `out-port'.  Initially the input should be on the
  94. ;;; first line of the functions comment.  After the comment and function 
  95. ;;; header have been read, the input will be such that the next line to be
  96. ;;; read will be the one after the function header.
  97. ;;; Returns : unspecified
  98. ;;;
  99. (define (scm2doc:extract-function in-port out-port)
  100.   (let ((comment (scm2doc:extract-comment in-port)))
  101.     (newline out-port)
  102.     (scm2doc:extract-function-header in-port out-port)
  103.     (scm2doc:output-comment comment out-port)))
  104.  
  105. ;;; Read a function header from the input port `in-port' and output it 
  106. ;;; to the output port `out-port'.  It expects the input to be somewhere
  107. ;;; before the line with the function name on it (all these lines will be 
  108. ;;; skipped).  It leaves the input such that the next line to be read would
  109. ;;; be the one after the function header.
  110. ;;; Returns : unspecified
  111. ;;; 
  112. ;;; This functions is currently quite primitive in the way it spots
  113. ;;; a function header.  It needs to be made much more general!
  114. ;;;
  115. (define (scm2doc:extract-function-header in-port out-port)
  116.   (let ((header (scm2doc:extract-skip-to "(define" in-port)))
  117.     (let* ((brace (string-find-char header #\( 7))
  118.        (start (if brace (+ 1 brace) 8))
  119.        (end (if brace
  120.             (string-find-char header #\) brace)
  121.             (string-length header))))
  122.       (display (substring header start end) out-port))))
  123.     
  124. ;;; Assumes that the input is such that the next line to be read will
  125. ;;; be a comment line.  (The usuall place from which to call this is
  126. ;;; directly after you have found one of the comment prefix characters
  127. ;;; on the current line).  Successive lines are read until the end
  128. ;;; of the comment section is detected.  This line is discarded and
  129. ;;; all the comments read so far are returned as a list of strings (in 
  130. ;;; reverse order).  For example given the following :-
  131. ;;;
  132. ;;; ;;;+f
  133. ;;; ;;; first line of comment
  134. ;;; ;;; second line of comment
  135. ;;; ;;;-f
  136. ;;; ;;; misc line.
  137. ;;;
  138. ;;; and assuming that the line containg +f has already been read, this
  139. ;;; will return ((" second line of comment") (" first line of comment"))
  140. ;;; and the input will be such that the next line read will be the one
  141. ;;; containing "misc line."
  142. ;;; Returns : unspecified
  143. ;;;
  144. (define (scm2doc:extract-comment in-port)
  145.   (let loop ((line (read-string in-port)) (comment '()))
  146.     (if (eof-object? line)
  147.     (error 'scm2doc:extract-comment "unexpected end of file"))
  148.     (if (< (string-length line) scm2doc:comment-prefix-len)
  149.     (error 'scm2doc:extract-comment "malformed line"))
  150.     (cond ((string-prefix? line scm2doc:generic-comment-end) comment)
  151.       ((string-prefix? line scm2doc:comment-prefix)
  152.        (loop
  153.         (read-string in-port)
  154.         (cons (substring line
  155.                  scm2doc:comment-prefix-len
  156.                  (string-length line))
  157.           comment)))
  158.        (else (error 'scm2doc:extract-comment "malformed line")))))
  159.  
  160. ;;; Output the list of strings in `comment' on the output port `out-port'
  161. ;;; Note it expects the list to be in reverse order!
  162. ;;; Returns : unspecified
  163. ;;;
  164. (define (scm2doc:output-comment comment out-port)
  165.   (if (not (null? comment))
  166.       (begin
  167.     (scm2doc:output-comment (cdr comment) out-port)
  168.     (newline out-port)
  169.     (display (car comment) out-port))))
  170.  
  171. ;;; Keeps reading and discarding lines, until the start of `line' matches
  172. ;;; `str'.  At which point it returns the line.
  173. ;;; Returns : string
  174. ;;;
  175. (define (scm2doc:extract-skip-to str in-port)
  176.   (let loop ((line (read-string in-port)))
  177.     (if (eof-object? line)
  178.     (error 'extract-skip-to "unexpected-end-of-file"))
  179.     (if (string-prefix? line str)
  180.     line
  181.     (loop (read-string in-port)))))
  182.